(* COPYRIGHT (C) 1979 Software Supply.  All rights reserved. *)
(*$S+*)
(* UCSD Pascal *) PROGRAM OTHELLO; (* Steve Brecher 16-Jun-79 *)
(* modified to be independant of the system clock - gws 01 Jan 83*)

(* The position evaluation weights were derived from a FORTRAN program   *)
(* headed "from Creative Computing/Klaus E Liebold/4-26-78".             *)

(* This program provides playing instructions to the user on request.    *)

CONST
   (* The game pieces are shown on the screen as 2 rows of 3 characters, e.g. *)
   (*                          OOO                                            *)
   (*                          OOO                                            *)
   (* If your crt has a "block" character (like the cursor on some crts), that*)
   (* is good for the white piece, and capital letter O is good for black,    *)
   (* especially if it has a rectangular shape.  Otherwise, choose characters *)
   (* that are centered within the character dot matrix; try to maximize the  *)
   (* difference in intensity between the black and white pieces while maxi-  *)
   (* mizing the absolute intensity of the black piece.  Avoid characters with*)
   (* semantic content, e.g. "W" and "B" are not so good.                     *)
   whiteascii = 96;     (*ascii value of char making up piece of first mover*)
   blackascii = 79;     (*  "     "   "   "     "     "    "   " 2nd    "   *)
  {minticks   = 22.0;   (*min # clock ticks between crt square updates      *)
                        (*--should be long enough for a distinct, separate  *)
                        (*terminal bell sound on each square updated        *)}
   dwell_time = 2000;   (*loop argument for delay between computer moves,
                          change it to produce about 2 or 3 beeps/second*)
   spaces     = '                             ';
   
TYPE
   coordinate   = 1..8;
   color        = (white,black);
   squareloc    = RECORD
                    CASE onboard: BOOLEAN OF
                      TRUE:            (row,col:        coordinate);
                    END;
   direction    = (north,south,east,west,sw,ne,se,nw); (*pairs of opposites*)
   squarestatus = RECORD
                    CASE occupied: BOOLEAN OF
                      TRUE:  (occupier:       color                           );
                      FALSE: (adjacentpieces: ARRAY[color] OF SET of direction);
                    END;
   gamestatus   = RECORD
                    boardstatus:  ARRAY[coordinate,coordinate] OF squarestatus;
                    nextmover:    color;
                    lastmoveloc:  squareloc;
                    score:        ARRAY[color] OF INTEGER;
                    END;
   movedesc     = RECORD
                    moveloc:            squareloc;
                    points:             INTEGER;
                    dirsflipped:        SET OF direction;
                    bordrsqsflipped:    INTEGER;
                    bordnoncorn:        BOOLEAN;
                    END;
   movelist     = RECORD
                    movecount:          INTEGER;
                    okmove:             ARRAY[1..30] OF movedesc;
                    END;
   position     = RECORD
                    border:             BOOLEAN;
                    corner:             BOOLEAN;
                    diagnexttocorner:   BOOLEAN;
                    incenter4by4:       BOOLEAN;
                    adjacentsq:         ARRAY[direction] OF squareloc;
                  (* "special" border squares are those border squares        *)
                  (* adjacent to a corner or adjacent to board midline; there *)
                  (* are 2 pairs of such squares on each border. Sample pair: *)
                  (* (1,2) and (1,4); for each we want a pointer to the other *)
                  (* and to the border square between them (1,3).             *)
                    CASE specialbordersq: BOOLEAN OF
                      TRUE:             (otherofpair,between:  squareloc);
                    END;


VAR
   board:                       ARRAY[coordinate,coordinate] OF position;
   status,crtstatus:            gamestatus;
   square:                      squareloc;
   legallist:                   movelist;
   move:                        movedesc;
   opposdir:                    ARRAY[direction] OF direction;
   legalmoves:                  ARRAY[color] OF INTEGER;
   colorword:                   ARRAY[color] OF STRING[5];
   usercolor:                   color;
   {lastchange:                  REAL; (*time of last square change on crt*)}
   delay:                       integer;
   
(* COPYRIGHT (C) 1979 Software Supply.  All rights reserved.  *)

PROCEDURE updatecrt(VAR oldstatus,newstatus: gamestatus);
FORWARD;
FUNCTION flipof(oldcolor: color): color;
FORWARD;
PROCEDURE makemove(VAR status: gamestatus; VAR move: movedesc; updateadjacent:
                                                                BOOLEAN);
FORWARD;

SEGMENT PROCEDURE initgame;
CONST
   backspace = 8;
VAR
   x,y:         coordinate;
   direc:       direction;
   answer:      CHAR;
   {h,l,h0,l0:   INTEGER; (*for testing whether clock is on*)}

   PROCEDURE defineboard;
   BEGIN
   FOR x := 1 TO 8 DO  FOR y := 1 TO 8 DO  WITH board[x,y] DO BEGIN
      border := (x IN [1,8]) OR (y IN [1,8]);
      corner := (x IN [1,8]) AND (y IN [1,8]);
      incenter4by4 := (x IN [3..6]) AND (y IN [3..6]);
      diagnexttocorner := (x IN [2,7]) AND (y IN [2,7]);
      FOR direc := north TO nw  DO WITH adjacentsq[direc] DO BEGIN 
         CASE direc OF
            north: onboard := x>1;
            ne:    onboard := (x>1) AND (y<8);
            east:  onboard := y<8;
            se:    onboard := (x<8) AND (y<8);
            south: onboard := x<8;
            sw:    onboard := (x<8) AND (y>1);
            west:  onboard := y>1;
            nw:    onboard := (x>1) AND (y>1);
            END; (*CASE*)
         IF onboard THEN BEGIN
            CASE direc OF
               north,ne,nw: row := x-1;
               east,west:   row := x;
               south,se,sw: row := x+1;
               END;
            CASE direc OF
               nw,west,sw:  col := y-1;
               north,south: col := y;
               ne,east,se:  col := y+1;
               END;
            END;
         END; (*FOR direc...WITH adjacentsq...*)
      specialbordersq := border AND (NOT corner) AND 
                            ( (x IN [2,4,5,7]) OR (y IN [2,4,5,7]) );
      IF specialbordersq THEN BEGIN
         otherofpair.onboard := TRUE;
         between.onboard := TRUE;
         IF x IN [1,8] THEN BEGIN
            otherofpair.row := x;
            between.row := x;
            IF y IN [2,5] THEN BEGIN
               otherofpair.col := y+2;
               between.col := y+1;
               END
            ELSE BEGIN
               otherofpair.col := y-2;
               between.col := y-1;
               END;
            END
         ELSE BEGIN
            otherofpair.col := y;
            between.col := y;
            IF x IN [2,5] THEN BEGIN
               otherofpair.row := x+2;
               between.row := x+1;
               END
            ELSE BEGIN
               otherofpair.row := x-2;
               between.row := x-1;
               END;
            END;
         END; (*IF specialbordersq...*)

      END; (*FOR x:= ... FOR y:= ... WITH board[x,y]...*)
   END; (*defineboard*)
    
   PROCEDURE showemptyboard;
   CONST
      vertdivs = '|     |     |     |     |     |     |     |     |';
      horzdivs = '|-----|-----|-----|-----|-----|-----|-----|-----|';
      colnames = '   A     B     C     D     E     F     G     H   ';
      blanks   = '                              ';
   VAR
      gamerow :    coordinate;
   BEGIN
   GOTOXY(0,0);
   FOR gamerow := 1 TO 8 DO BEGIN
      IF gamerow>1 THEN (* "IF" because no room for topmost border line *)
         writeln(blanks,horzdivs);
      writeln(blanks:29,gamerow,vertdivs);
      writeln(blanks,vertdivs);
      END;
   write(blanks,colnames);
   GOTOXY(4,0);
   WRITELN('Score');
   WRITELN('-----------');
   WRITELN(CHR(whiteascii),'/White:');
   WRITELN(CHR(blackascii),'/Black:');
   END; (*showemptyboard*)
  
   PROCEDURE instructions;
   VAR
      i: INTEGER;
   PROCEDURE page1;
      BEGIN
      WRITELN('A move consists of placing  ');
      WRITELN('one of your pieces on an    ');
      WRITELN('unoccupied square which is  ');
      WRITELN('adjacent (vertically, hori- ');
      WRITELN('zontally, or diagonally) to ');
      WRITELN('a square occupied by your   ');
      WRITELN('opponent so that a straight ');
      WRITELN('line starting at your piece ');
      WRITELN('and continuing in the direc-');
      WRITELN('tion of the adjacent oppon- ');
      WRITELN('ent hits one of your other  ');
      WRITELN('pieces before hitting an un-');
      WRITELN('occupied square.  All of the');
      WRITELN('opponent''s pieces which that');
      WRITELN('line crosses are converted  ');
      WRITELN('to become your pieces.  Thus');
      WRITELN('each move "flips" at least  ');
      WRITELN('one opposing piece.         ');
      WRITE  (' (Tap space bar for more...)');
      END; (*page1*)
   PROCEDURE page2;
      BEGIN
      WRITELN('Example:  a legal move for  ');
      WRITELN('white on the first play     ');
      WRITELN('would be 3E, 4F, 6D, or 5C. ');
      WRITELN('To make a move at, e.g., 3E ');
      WRITELN('you may type any of: 3E, 3e,');
      WRITELN('E3, or e3.                  ');
      WRITELN('If you have no legal move,  ');
      WRITELN('you must pass.  The object  ');
      WRITELN('of the game is to end up    ');
      WRITELN('occupying more squares than ');
      WRITELN('does your opponent.         ');
      WRITELN('Hints on strategy:  Usually ');
      WRITELN('the board position of a move');
      WRITELN('is more important than the  ');
      WRITELN('number of pieces it "flips".');
      WRITELN('Try to occupy the borders   ');
      WRITELN('(especially corners!) and   ');
      WRITELN('avoid giving them to your   ');
      WRITE  ('opponent. (Tap space bar...)');
      END; (*page2*)
   BEGIN (*instructions*)
   GOTOXY(0,5);
   WRITE('Want instructions? (y/n): ');
   READ(answer);
   IF NOT (answer IN ['N','n']) THEN BEGIN
      GOTOXY(0,5);
      page1;
      READ(answer);
      GOTOXY(0,5);
      page2;
      READ(answer);
      GOTOXY(0,5);
      FOR i := 5 TO 22 DO
         WRITELN(spaces);
      WRITE(spaces);
      END
   ELSE BEGIN
      GOTOXY(0,5);
      WRITE(spaces);
      END;
   END; (*instructions*)
      
BEGIN (*initgame*)
{lastchange := 0;
TIME(h0,l0);}
defineboard;
FOR direc := north TO NW DO
   IF odd(ORD(direc)) THEN
      opposdir[direc] := pred(direc)
   ELSE
      opposdir[direc] := succ(direc);
{TIME(h,l);
IF (h=h0) AND (l=l0) THEN BEGIN
   GOTOXY(20,11);
   WRITE('Please turn on the clock.');
   WHILE l=l0 DO
      TIME(h,l);
   END;}
showemptyboard;
WITH status DO BEGIN
   score[white] := 0;
   score[black] := 0;
   FOR x := 1 TO 8 DO  FOR y := 1 TO 8 DO WITH boardstatus[x,y] DO BEGIN
      occupied := FALSE;
      adjacentpieces[white] := [];
      adjacentpieces[black] := [];
      END;
   END;
crtstatus := status;
move.dirsflipped := [];
move.points := 0;
WITH status DO BEGIN
   FOR x := 4 TO 5 DO  FOR y := 4 TO 5 DO BEGIN
      move.moveloc.row := x;
      move.moveloc.col := y;
      IF x=y THEN
         nextmover := white
      ELSE
         nextmover := black;
      makemove(status,move,TRUE);
      updatecrt(crtstatus,status);
      crtstatus := status;
      END; (*FOR...FOR...*)
   nextmover := white;
   END; (*WITH status...*)
instructions;
GOTOXY(0,6);
WRITELN('White goes first -- Which');
WRITELN('color do you want to play:');
REPEAT
   GOTOXY(3,8);
   WRITE('W)hite or B)lack?  ',CHR(backspace));
   READ(answer);
   UNTIL answer IN ['W','w','B','b'];
IF answer IN ['W','w'] THEN
   usercolor := white
ELSE 
   usercolor := black;
GOTOXY (0,6);
WRITELN(spaces); WRITELN(spaces); WRITELN(spaces);
colorword[white] := 'white';
colorword[black] := 'black';
END; (*initgame*)

FUNCTION flipof(*oldcolor: color): color*);
BEGIN
IF oldcolor = white THEN
   flipof := black
ELSE
   flipof := white;
END; (*flipof*)

PROCEDURE updatecrt(*VAR oldstatus,newstatus: gamestatus*);
VAR
   x,y:         coordinate;
   direc:       direction;
   square:      squareloc;

   PROCEDURE showpiece(square: squareloc);
      
      PROCEDURE changecrtsq(square: squareloc);
      CONST
         bell = 7;
      VAR
         s:                     PACKED ARRAY[1..3] OF CHAR;
         c:                     CHAR;
         crtline,crtcol:        INTEGER;
         h,l:                   INTEGER;
         {now:                   REAL;}
      BEGIN
      WITH square DO BEGIN
         IF newstatus.boardstatus[row,col].occupier = white THEN
            c := CHR(whiteascii)
         ELSE
            c := CHR(blackascii);
         FILLCHAR(s,3,c);
         crtline := (3*row) - 3;
         crtcol  := 26 + (6*col);
         END;
      {REPEAT
         TIME(h,l);
         now := l;
         IF now < 0.0 THEN
            now := now + 65536.0;
         now := (h*65536.0) + now;
         UNTIL (now - lastchange) > minticks;} 
      for delay := 1 to dwell_time do; {waste some time}
      GOTOXY(crtcol,crtline);
      WRITE(s);
      GOTOXY(crtcol,crtline+1);
      WRITE(s,CHR(bell));
      {lastchange := now;}
      END; (*changecrtsq*)
   
   BEGIN (*showpiece*)
   WITH square DO
      IF newstatus.boardstatus[row,col].occupied THEN
         IF NOT oldstatus.boardstatus[row,col].occupied THEN
            changecrtsq(square)
         ELSE IF oldstatus.boardstatus[row,col].occupier <>
                 newstatus.boardstatus[row,col].occupier THEN
                 changecrtsq(square);
   END; (*showpiece*)

BEGIN (*updatecrt*)
WITH newstatus DO BEGIN
   showpiece(lastmoveloc);
   FOR direc := north to nw DO BEGIN
      square := lastmoveloc;
      WHILE boardstatus[square.row,square.col].occupied AND
            board[square.row,square.col].adjacentsq[direc].onboard DO BEGIN
         square := board[square.row,square.col].adjacentsq[direc];
         showpiece(square);
         END; (*WHILE...*)
      END; (*FOR direc...*)
   GOTOXY(9,2);
   WRITE(score[white]:2);
   GOTOXY(9,3);
   write(score[black]:2);
   END; (*WITH newstatus...*)
GOTOXY(0,0);
END; (*updatecrt*)


(*$I othello.1.text*)



